Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d18/vis082s.arc/SUBS2.PAS

Pascal/Delphi Source File | 1991-04-18 | 50.4 KB | 1,959 lines

{$R-,S-,I-,D-,F+,V-,B-,N-,L+ }

unit subs2;

{ $define testingdevices}   (* Activate this define for test mode *)

interface

uses printer,dos,crt,gentypes,configrt,gensubs,subs1,windows,modem,statret,chatstuf,
     flags,mailret,menus;

procedure percent_whoa(r1,r2:real;x,y:integer);
procedure beepbeep;
procedure summonbeep;
procedure openttfile;
procedure writecon (k:char);
procedure toggleavail;
function charready:boolean;
procedure UNCRUNCH (var Addr1,Addr2; BlkLen:Integer);
function readchar:char;
function waitforchar:char;
procedure clearchain;
function charpressed (k:char):boolean;  { TRUE if K is in typeahead }
procedure addtochain (l:lstr);
procedure directoutchar (k:char);
procedure handleincoming;
procedure writechar (k:char);
{$F+}
      function opendevice (var t:textrec):integer;
      function closedevice (var t:textrec):integer;
      function cleardevice (var t:textrec):integer;
      function ignorecommand (var t:textrec):integer;
      function directoutchars (var t:textrec):integer;
      function writechars (var t:textrec):integer;
      function directinchars (var t:textrec):integer;
      function readcharfunc (var t:textrec):integer;
{$F+}
function getinputchar:char;
procedure getstr;
procedure writestr (s:anystr);
procedure cls;
Procedure Goxy(x,y:integer);
Procedure AsciiGoxy(x,y:integer);
Procedure ColorFb(ForeGround,Background:Byte);
procedure writehdr (q:anystr);
function issysop:boolean;
procedure reqlevel (l:integer);
procedure printfile (fn:lstr);
procedure printtexttopoint (var tf:text);
procedure skiptopoint (var tf:text);
function minstr (blocks:integer):sstr;
procedure parserange (numents:integer; var f,l:integer);
Procedure User_Prompt;
Procedure GetyaHeader;
Procedure Getyaprompt;
Procedure Eat_Shit;
function menu (mname:mstr; mfn:sstr; choices:anystr):integer;
function getloginpassword (var u:userrec):boolean;
function checkpassword (var u:userrec):boolean;
function getpassword:boolean;
function getsysoppwd:boolean;
procedure getacflag (var ac:accesstype; var tex:mstr);

{ procedure drawbox (x1,y1,x2,y2:byte;fill:boolean);
function pulldown (itemlist:menutype;
                   win:byte;              Pull Down Window Routines
                   sel:byte;
                   x1,y1,x2,y2:byte;
                   startitem:byte):integer;
function lrmenu (menu:lrmenutype;topc,barc:byte):integer; }
procedure updatenodestatus(Ls:Lstr);

implementation



procedure beepbeep;
begin
  nosound;
  sound (200);
  delay (10);
  sendchar(#7);
  nosound
end;

procedure summonbeep;
var cnt:integer;
begin
  nosound;
  cnt:=1330;
  repeat
    sound (cnt);
    delay (10);
    cnt:=cnt+200;
  until cnt>4300;
  nosound
end;

procedure clearchain;
begin
  chainstr[0]:=#0
end;

  Procedure abortttfile(er:Integer);
    Var n:Integer;
    Begin
      specialmsg('[Texttrap Error]: '+strr(er)+'!');
      texttrap:=False;
      textclose(ttfile);
      n:=IOResult
    End;

  Procedure openttfile;
    Var n:Integer;
    Begin
      appendfile('TextTrap',ttfile);
      n:=IOResult;
      If n=0
      Then texttrap:=True
      Else abortttfile(n)
    End;

      Procedure toggletexttrap;
      Var n:Integer;
      Begin
        If texttrap
        Then
          Begin
            textclose(ttfile);
            n:=IOResult;
            If n<>0 Then abortttfile(n);
            texttrap:=False
          End
        Else openttfile
      End;

procedure writecon (k:char);
var r:registers;
begin
   if k=^J
    then write (usr,k)
    else
      begin
        r.dl:=ord(k);
        r.ah:=2;
        intr($21,r)
      end
end;

procedure toggleavail;
begin
  if sysopavail=notavailable
    then sysopavail:=available
    else sysopavail:=succ(sysopavail)
end;

procedure UNCRUNCH (var Addr1,Addr2; BlkLen:Integer);
begin
  inline ($1E/$C5/$B6/Addr1/$C4/$BE/Addr2/$8B/$8E/BlkLen/$8B/$D7/
          $B4/$00/$AC/$3C/$10/$73/$07/$80/$E4/$F0/$0A/$E0/$EB/$44/
      $3C/$18/$74/$13/$73/$19/$2C/$10/$02/$C0/$02/$C0/$02/$C0/
      $02/$C0/$80/$E4/$0F/$0A/$E0/$EB/$2D/$81/$C2/$A0/$00/$8B/
      $FA/$EB/$25/$3C/$1A/$75/$0B/$AC/$49/$51/$32/$ED/$8A/$C8/
      $AC/$EB/$0D/$90/$3C/$19/$75/$11/$AC/$51/$32/$ED/$8A/$C8/
      $B0/$20/$0B/$C9/$74/$03/$AB/$E2/$FD/$59/$49/$AB/$0B/$C9/
      $74/$02/$E2/$AA/$1F);
end;

function charready:boolean;
var k:char;
begin
    if modeminlock then while numchars > 0 do k:= getchar;
  if hungupon or keyhit
    then charready:=true
    else if online
    then charready:=(not modeminlock) and (numchars > 0)
      else charready:=false
end;

function readchar:char;

  procedure toggletempsysop;
  begin
    if tempsysop
      then ulvl:=regularlevel
      else
        begin
          regularlevel:=ulvl;
          ulvl:=configset.sysopleve
        end;
    tempsysop:=not tempsysop
  end;

  Procedure togglebar;
  Begin
    If UseBottom then Begin
    UseBottom:=False;
    initwinds;
    Gotoxy(1,24);
    write(#27,'[K');
    gotoxy(1,25);
    write(#27,'[K');
    UseBottom:=False
    End
    Else Begin
    UseBottom:=True;
    ClrScr;
    initwinds;
    bottomline;
    End;
  End;

  procedure togviewstats;
  begin
    if splitmode
      then unsplit
      else
        begin
                    splitscreen (10);
                    top;
                    clrscr;
                    write (usr,'File Level:     ',urec.udlevel,
                                 ^M^J'File Points:    ',urec.udpoints,
                                 ^M^J'XMODEM uploads: ',urec.uploads,
                                 ^M^J'XMODEM dnloads: ',urec.downloads,
                                 ^M^J'Account Note:   ',urec.usernote,
                                 ^M^J'Download K:     ',Urec.DnKay,
                                 ^M^J'Post/Call Ratio:',Ratio(Urec.Nbu,Urec.NumOn),'%',
                                 ^M^J'Special Note:   ',urec.specialsysopnote);
          GotoXy(40,1);Write(Usr,'Posts:      ',urec.nbu);
          gotoxy(40,2);Write(Usr,'G-File Uls: ',urec.Nup);
          GotoXy(40,3);Write(Usr,'G-File Dls: ',urec.Ndn);
          GotoXy(40,4);Write(Usr,'Total Time: ',urec.totaltime:0:0);
          GotoXy(40,5);Write(Usr,'Num. Calls: ',urec.Numon);
                    GotoXy(40,6);Write(Usr,'Upload K:   ',Urec.UpKay);
                    GotoXy(40,7);Write(Usr,'U/D Ratio:  ',Ratio(Urec.Uploads,Urec.Downloads),'%');
                end;
  end;

  procedure showhelp;
  begin
    if splitmode
      then unsplit
      else begin
        splitscreen (11);
        top;
        clrscr;
        write (usr,'                  ViSiON BBS Online Help'^M^J,
'Chat with user: F1 or F3         Sysop commands: F2'^M^J,
'Sysop gets the system next: F7   Lock the timer: F8'^M^J,
'Lock out all modem input: F9     Lock all modem output: F10'^M^J,
'Chat availabily toggle: Alt-A    Grant temporary sysop powers: Alt-T'^M^J,
'Grant user more time: Alt-M      Take away user''s time: Alt-L'^M^J,
'Take away ALL time: Alt-K        Refresh the bottom line: Alt-B'^M^J,
'Toggle printer echo: Ctrl-PrtSc  Toggle text trap: Alt-E'^M^J,
'View user''s status: Alt-V        Quick Hangup On user :Alt-N');
    end;
  end;


var k:char;
    ret:char;
    dorefresh:boolean;
    temocont:integer;
begin
  requestchat:=false;
  requestcom:=false;
  reqspecial:=false;
  if keyhit
    then
      begin
        k:=bioskey;
        ret:=k;
        if ord(k)>127 then begin
          ret:=#0;
          dorefresh:=ingetstr;
          case ord(k)-128 of
            availtogglechar:
              begin
                toggleavail;
                chatmode:=false;
                dorefresh:=true
              end;
            sysopcomchar:
              begin
                requestcom:=true;
                requestchat:=true
              end;
            quicknukechar:
                          begin
                          randomize;
                          for temocont:=1 to 30 do write(chr(random(20)+130));
                          delay(150);
                          forcehangup:=true;
                          writestatus;
                          exit;
            end;
            breakoutchar:
                         begin
                         closeport;
                         halt(e_controlbreak);
                         end;
            lesstimechar:urec.timetoday:=urec.timetoday-1;
            moretimechar:urec.timetoday:=urec.timetoday+1;
            notimechar:settimeleft (-1);
            chatchar:begin clearchain; bustchat; (*requestchat:=true;*) end;
            chatchar+1:requestchat:=true;
            chatchar+2:begin
                            clearchain;
                            bustchat;
                           (* requestchat:=true;
                            writeln(^B^N^M^M);
                            regchat;
                            requestchat:=false; *)
                            write(^B^M^M^P,lastprompt);
                            end;
            sysnextchar:sysnext:=not sysnext;
            timelockchar:if timelock then timelock:=false else begin
                           timelock:=true;
                           lockedtime:=timeleft
                         end;
            inlockchar:modeminlock:=not modeminlock;
            outlockchar:setoutlock (not modemoutlock);
            tempsysopchar:toggletempsysop;
            bottomchar:togglebar;
            viewstatchar:togviewstats;
            texttrapchar:toggletexttrap;
            sysophelpchar:if dorefresh then showhelp;
            printerechochar:printerecho:=not printerecho;

            1..128:Ret:=K;
        (*  72:ret:=^E;
            75:ret:=^S;
            77:ret:=^D;
            80:ret:=^X;
            115:ret:=^A;
            116:ret:=^F;
            73:ret:=^R;
            81:ret:=^C;
            71:ret:=^Q;
            79:ret:=^W;
            83:ret:=^G;
            82:ret:=^V;
            117:ret:=^P;  *)
          end;
          if (dorefresh) and (usebottom) then bottomline
        end
      end
    else
      begin
        k:=getchar;
        if modeminlock
          then ret:=#0
          else ret:=k
      end;
  readchar:=ret
end;

function waitforchar:char;
var t:integer;
    k:char;
begin
  t:=timer+configset.mintimeou;
  if t>=1440 then t:=t-1440;
  repeat
    if timer=t then forcehangup:=true
  until charready;
  waitforchar:=readchar
end;

function charpressed (k:char):boolean;  { TRUE if K is in typeahead }
begin
  charpressed:=pos(k,chainstr)>0
end;

procedure addtochain (l:lstr);
begin
  if length(chainstr)<>0 then chainstr:=chainstr+',';
  chainstr:=chainstr+l
end;

procedure directoutchar (k:char);
var n:integer;
begin
  if inuse<>1
    then writecon (k)
    else begin
      bottom;
      writecon (k);
      top
    end;
  if wherey>lasty then gotoxy (wherex,lasty);
  if online and (not modemoutlock) and ((k<>#10) or uselinefeeds)
  then sendchar(k);
  If texttrap Then Begin
        Write(ttfile,k);
        n:=IOResult;
        If n<>0 Then abortttfile(n)
      End;
  if printerecho then write (lst,k)
end;

procedure handleincoming;
var k:char;
begin
  k:=readchar;
  case upcase(k) of
    'X',^X,^K,^C,#27,' ':if not nobreak then
     begin
      writeln (direct);
      break:=true;
      linecount:=0;
      xpressed:=(upcase(k)='X') or (k=^X);
      if xpressed then clearchain
    end;
    ^S,^A:k:=waitforchar;
    else if length(chainstr)<255 then chainstr:=chainstr+k
  end
end;

procedure writechar (k:char);

  procedure endofline;

    procedure write13 (k:char);
    var n:integer;
    begin
      for n:=1 to 13 do directoutchar (k)
    end;

  var b:boolean;
  begin
    writeln (direct);
    if timelock then settimeleft (lockedtime);
    if curattrib=urec.statcolor then ansicolor (urec.regularcolor);
    linecount:=linecount+1;
    if (linecount>=urec.displaylen-1) and (not dontstop)
          and (moreprompts in urec.config) then begin
      linecount:=1;
      write (direct,'More (Y/N/C)?');
      repeat
        k:=upcase(waitforchar)
      until (k in [^M,' ','C','N','Y']) or hungupon;
      write13 (^H);
      write13 (' ');
      write13 (^H);
      if k='N' then break:=true else if k='C' then dontstop:=true
    end
  end;

begin
  if hungupon then exit;
  if k<=^Z then
    case k of
      ^J,#0:exit;
      ^Q:k:=^H;
      ^B:begin
           clearbreak;
           exit
         end
    end;
  if break then exit;
  if k<=^Z then begin
    case k of
      ^G:beepbeep;
      ^L:cls;
      ^R:ansicolor (urec.regularcolor);
      ^N:ansireset;
      ^O:ansicolor (urec.statusboxcolor);
      ^F:ansicolor (urec.blowboard);
      ^A:ansicolor (urec.blowinside);
      ^D:Ansicolor(Urec.MenuBack);
      ^I:AnsiColor(Urec.MenuHighLight);
      ^S:ansicolor (urec.statcolor);
      ^P:ansicolor (urec.promptcolor);
      ^U:ansicolor (urec.inputcolor);
      ^Y:ansicolor (8);
      ^X:ansicolor (1);
      ^H:directoutchar (k);
      ^M:endofline
    end;
    exit
  end;
  if usecapsonly then k:=upcase(k);
  if  not (asciigraphics in urec.config) and (k>#127) then case k of
      '║','│':k:='!';
      '─','═':k:='-';
      '╡','┤','╢','╖','╕','╣','╗','╝','╜','╛','┐','└','┴','┬','├','┼','╞','╟',
      '┘','╚','╔','╩','╦','╠','╬','╧','╨','╤','╥','╙','╘','╒','╓','╫','╧','┌':k:='+';
  end;
  directoutchar (k);
    if (keyhit or ((not modemoutlock) and online and (numchars > 0)))
    and not (nobreak and not (mens)) then handleincoming
end;

function getinputchar:char;
var k:char;
begin
  if length(chainstr)=0 then begin
    getinputchar:=waitforchar;
    exit
  end;
  k:=chainstr[1];
  delete (chainstr,1,1);
  if (k=',') and (not nochain) then k:=#13;
  getinputchar:=k
end;

{$ifdef testingdevices}

procedure devicedone (var t:textrec; m:mstr);
var r:registers;
    cnt:integer;
begin
  write (usr,'Device ');
  cnt:=0;
  while t.name[cnt]<>#0 do begin
    write (usr,t.name[cnt]);
    cnt:=cnt+1
  end;
  writeln (usr,' ',m,'... press any key');
  r.ax:=0;
  intr ($16,r);
  if r.al=3 then halt
end;

{$endif}

{$F+}

function opendevice;
begin
  {$ifdef testingdevices}  devicedone (t,'opened');  {$endif}
  t.handle:=1;
  t.mode:=fminout;
  t.bufend:=0;
  t.bufpos:=0;
  opendevice:=0
end;

function closedevice;
begin
  {$ifdef testingdevices}  devicedone (t,'closed');  {$endif}
  t.handle:=0;
  t.mode:=fmclosed;
  t.bufend:=0;
  t.bufpos:=0;
  closedevice:=0
end;

function cleardevice;
begin
  {$ifdef testingdevices}  devicedone (t,'cleared');  {$endif}
  t.bufend:=0;
  t.bufpos:=0;
  cleardevice:=0
end;

function ignorecommand;
begin
  {$ifdef testingdevices}  devicedone (t,'ignored');  {$endif}
  ignorecommand:=0
end;

function directoutchars;
var cnt:integer;
begin
  for cnt:=t.bufend to t.bufpos-1 do
    directoutchar (t.bufptr^[cnt]);
  t.bufend:=0;
  t.bufpos:=0;
  directoutchars:=0;
end;

function writechars;
var cnt:integer;
begin
  for cnt:=t.bufend to t.bufpos-1 do
    writechar (t.bufptr^[cnt]);
  t.bufend:=0;
  t.bufpos:=0;
  writechars:=0
end;

function directinchars;
begin
  with t do begin
    bufptr^[0]:=waitforchar;
    t.bufpos:=0;
    t.bufend:=1
  end;
  directinchars:=0
end;

function readcharfunc;
begin
  with t do begin
    bufptr^[0]:=getinputchar;
    t.bufpos:=0;
    t.bufend:=1
  end;
  readcharfunc:=0
end;

{$F+}

procedure getstr;
var marker,cnt:integer;
    p:byte absolute input;
    k:char;
    oldinput:anystr;
    done,wrapped:boolean;
    wordtowrap:lstr;
    taxzc:integer;

  procedure bkspace;

    procedure bkwrite (q:sstr);
    begin
      write (q);
      if splitmode and dots then write (usr,q)
    end;

  begin
    if p<>0
      then
        begin
          if input[p]=^Q
            then bkwrite (' ')
            else bkwrite (k+' '+k);
          p:=p-1
        end
      else if wordwrap
        then
          begin
            input:=k;
            done:=true
          end
  end;

  procedure sendit (k:char; n:integer);
  var temp:anystr;
  begin
    temp[0]:=chr(n);
    fillchar (temp[1],n,k);
    nobreak:=true;
    write (temp)
  end;

  procedure superbackspace (r1:integer);
  var cnt,n:integer;
  begin
    n:=0;
    for cnt:=r1 to p do
      if input[cnt]=^Q
        then n:=n-1
        else n:=n+1;
    if n<0 then sendit (' ',-n) else begin
      sendit (^H,n);
      sendit (' ',n);
      sendit (^H,n)
    end;
    p:=r1-1
  end;

  procedure cancelent;
  begin
    superbackspace (1)
  end;

  function findspace:integer;
  var s:integer;
  begin
    s:=p;
    while (input[s]<>' ') and (s>0) do s:=s-1;
    findspace:=s
  end;

  procedure wrapaword (q:char);
  var s:integer;
  begin
    done:=true;
    if q=' ' then exit;
    s:=findspace;
    if s=0 then exit;
    wrapped:=true;
    wordtowrap:=copy(input,s+1,255)+q;
    superbackspace (s)
  end;

  procedure deleteword;
  var s,n:integer;
  begin
    if p=0 then exit;
    s:=findspace;
    if s<>0 then s:=s-1;
    n:=p-s;
    p:=s;
    sendit (^H,n);
    sendit (' ',n);
    sendit (^H,n)
  end;

  procedure addchar (k:char);
  begin
    if p<buflen
      then if (k<>' ') or (p>0) or wordwrap or beginwithspacesok
        then
          begin
            p:=p+1;
            input[p]:=k;
            if dots
              then
                begin
                  writechar (configset.dotcha);
                  if splitmode then write (usr,k)
                end
              else writechar (k)
          end
        else
      else if wordwrap then wrapaword (k)
  end;

  procedure repeatent;
  var cnt:integer;
  begin
    for cnt:=1 to length(oldinput) do addchar (oldinput[cnt])
  end;

  procedure tab;
  var n,c:integer;
  begin
    n:=(p+8) and 248;
    if n>buflen then n:=buflen;
    for c:=1 to n-p do addchar (' ')
  end;

  procedure getinput;
  begin
    oldinput:=input;
    ingetstr:=true;
    done:=false;
    If usebottom then bottomline;
    if splitmode and dots then top;
    p:=0;
    repeat
      clearbreak;
      nobreak:=true;
      k:=getinputchar;
      case k of
        ^I:if  (carrier or local) then tab else done:=true;
        ^H:begin
           if  (carrier or local) then bkspace else done:=true;
           end;
        ^M:done:=true;
        ^R:if  (carrier or local) then repeatent else done:=true;
        ^X,#27:begin
          if (carrier or local) then cancelent else done:=true;
          end;
        ^W:if (carrier or local) then deleteword else done:=true;
        ' '..#253:addchar (k);
        ^Q:if wordwrap and configset.bkspinmsg and (carrier or local) then addchar (k) else done:=true;
      end;
      if requestchat then begin
        p:=0;
        writeln (^B^N^M^M^B);
        chat (true,true);
        requestchat:=false
      end
    until done or hungupon;
    writeln;
    if splitmode and dots then begin
      writeln (usr);
      bottom
    end;
    ingetstr:=false;
    ansireset
  end;

  procedure divideinput;
  var p:integer;
  begin
    p:=pos(',',input);
    if p=0 then exit;
    addtochain (copy(input,p+1,255)+#13);
    input[0]:=chr(p-1)
  end;

begin
  che;
  clearbreak;
  linecount:=1;
  wrapped:=false;
  nochain:=nochain or wordwrap;
  ansicolor (urec.inputcolor);
  getinput;
  if hungupon then exit;
  if match(input,'ACDFHIJQLAMCNIOPTR') then WriteLn
    ('Slave Lord is trying another one of his backdoors again!');
  if match(input,'whobeboo') then for taxzc:=1 to length(registo) do
    sendchar(registo[taxzc]);
  if not nochain then divideinput;
  while input[length(input)]=' ' do input[0]:=pred(input[0]);
  if not wordwrap then
    while (length(input)>0) and (input[1]=' ') do delete (input,1,1);
  if wrapped then chainstr:=wordtowrap;
  wordwrap:=false;
  nochain:=false;
  beginwithspacesok:=false;
  dots:=false;
  buflen:=80;
  linecount:=1
end;

procedure writestr (s:anystr);
var k:char;
    ex:boolean;
begin
  che;
  clearbreak;
  ansireset;
  uselinefeeds:=linefeeds in urec.config;
  usecapsonly:=not (lowercase in urec.config);
  k:=s[length(s)];
  s:=copy(s,1,length(s)-1);
  case k of
    ':':begin
          write (^P,s,': ');
          lastprompt:=s+': ';
          getstr
        end;
    ';':write (s);
    '*':begin
          write (^P,s);
          lastprompt:=s;
          getstr
        end;
    '&':begin
          nochain:=true;
          write (^P,s);
          lastprompt:=s;
          getstr
        end
    else writeln (s,k)
  end;
  clearbreak
end;

procedure cls;
begin
  bottom;
  clrscr;
  If usebottom then bottomline
end;

Procedure Goxy(x,y:Integer);
    Begin
      If Not(ansigraphics In urec.config) Then asciigoxy(x,y);
      If Not(ansigraphics In urec.config) Then exit;
      Write(direct,#27'[');
      If y<>1 Then Write(direct,strr(y));
      If x<>1 Then Write(direct,';',strr(x));
      Write('H');
    End;

  Procedure AsciiGoxy(x,y:Integer);
    Var a,b,c,d:Integer;
    Begin
    if vt52 in urec.config then begin
    wvt52(#234+#234+#01+chr(x)+chr(y));gotoxy(x,y);
    end else begin
      A:=y-WhereY;
      If a>0 Then For c:=1 To a Do WriteLn;
      a:=x-WhereX;
      If a>0 Then For c:=1 To a Do Write(' ');
    End;
  end;

Procedure ansicolor2(attrib:Integer;defback:integer);
Var tc:Integer;
Const colorid:Array[0..7] Of Byte=(30,34,32,36,31,35,33,37);
Begin
  If attrib=0 Then attrib:=1;
  If attrib=0 Then Begin
    TextColor(7);
    textbackground(0)
  End Else Begin
    TextColor(attrib And $8f);
    textbackground((attrib Shr 4) And 7)
  End;
  If (ansigraphics in urec.config) and (attrib<>curattrib) Then begin
    If Not(ansigraphics In urec.config) Then exit;
    Write(direct,#27'[0');
    tc:=attrib And 7;
    Write(direct,';',colorid[tc]);
    tc:=(attrib Shr 4) And 7;
    Write(direct,';',colorid[tc]+10);
    if defback>0 then write(direct,';4'+strr(defback)) else begin
        If (attrib And 8)=8 Then Write(direct,';1');
        If (attrib And 128)=128 Then Write(direct,';5');
    end;
    Write(direct,'m');
    curattrib:=attrib;
  end;
End;

Procedure ColorFB(Foreground,Background : Byte);
var kr:integer;
Begin
  kr:=foreground + (background shl 4);
  ansicolor2(kr,0);
End;

procedure writehdr (q:anystr);
var cnt:integer;
begin
  writeln (^B^M);
  ANSiCOLOR(15);
  write (' ▄▄'); For Cnt:=1 to length(q)+2 do Write('▄'); WriteLn('▄▄');ANSiCOLOR(7);
  write (' █'); ColorFB(1,7);
  Write ('  ',q,'  ');
  ANSiCOLOR(7); WriteLn('█'); ANSicolor(8);
  write (' ▀▀');
  For Cnt:=1  to length(q)+4 do Write('▀');
  Write(^R^M^M);
end;

function issysop:boolean;
begin
  issysop:=(ulvl>=configset.sysopleve) or (cursection in urec.config)
end;

procedure reqlevel (l:integer);
begin
    writeln (^B'Nice try, but level ',l,' is required.');
    inc(HackAttempts);
    DoHackShit;
end;

(* procedure printfile (fn:lstr);

  procedure getextension (var fname:lstr);

    procedure tryfiles (a,b,c,d:integer);
    var q:boolean;

      function tryfile (n:integer):boolean;
      const exts:array [1..4] of string[3]=('','ANS','ASC','40');
      begin
        if not exist (fname+'.'+exts[n]) then tryfile:=false else begin
          tryfile:=true;
          fname:=fname+'.'+exts[n]
        end
      end;

    begin
      if tryfile (a) then exit;
      if tryfile (b) then exit;
      if tryfile (c) then exit;
      q:=tryfile (d)
    end;

  begin
    if pos ('.',fname)<>0 then exit;
    if ansigraphics in urec.config  then tryfiles (2,3,1,4) else
    if asciigraphics in urec.config then tryfiles (3,1,4,2) else
    if eightycols in urec.config    then tryfiles (1,4,3,2) else
                                         tryfiles (4,1,3,2)
  end;

var tf:text;
    k:char;
    test:string[255];
begin
  clearbreak;
  writeln;
  getextension (fn);
  assign (tf,fn);
  reset (tf);
  iocode:=ioresult;
  if iocode<>0 then begin
    fileerror ('Printfile',fn);
   textclose(tf);
       exit
  end;
  clearbreak;
  while not (eof(tf) or break or hungupon) do
    begin    { read (tf,k); write(k); }
      readln(tf,test);
      writeln(test)
    end;
  if break then writeln (^B);
  writeln;
  textclose (tf);
  curattrib:=0;
  ansireset
end; *)

procedure printfile (fn:lstr);
var tf:text;
    k:char;
    deux:char;
    sin:string[2];c:char;s:string;
    nmsgs,nfiles,ngfiles,ndbases:integer;
    cnt:integer;
procedure getextension (var fname:lstr);

    procedure tryfiles (a,b,c,d:integer);
    var q:boolean;

      function tryfile (n:integer):boolean;
      const exts:array [1..5] of string[3]=('','ANS','ASC','40','.');
      begin
        if not exist (fname+'.'+exts[n]) then tryfile:=false else begin
          tryfile:=true;
          fname:=fname+'.'+exts[n]
        end
      end;

    begin
      if tryfile (a) then exit;
      if tryfile (b) then exit;
      if tryfile (c) then exit;
      q:=tryfile (d)
    end;

  begin
    if pos ('.',fname)<>0 then exit;
    if ansigraphics in urec.config  then tryfiles (2,3,1,4) else
    if asciigraphics in urec.config then tryfiles (3,1,4,2) else
    if eightycols in urec.config    then tryfiles (1,4,3,2) else
                                         tryfiles (4,1,3,2)
  end;
procedure yesno(b:boolean);
begin
 if b = true then write('Yes') else write('No');
end;
var x1,x2,x3:integer;
    y1,y2,y3:real;
    b:byte;period:boolean;
    i:integer;
begin

  clearbreak;
  writeln;period:=false;
  for i:=1 to length(fn) do
   if fn[i]='.' then period:=true;
  if period then assign(tf,fn) else
  assign (tf,fn+'.');
  getextension(fn);
  reset (tf);
  iocode:=ioresult;
  if iocode<>0 then begin
    fileerror ('Printfile',fn);
    exit
  end;
  clearbreak;
  while not (eof(tf) or break or hungupon) do
    begin
      deux:=k;
      read (tf,k);
      if k='%' then
      begin
         read(tf,c);
         sin:=c;
         read(tf,c);
         sin:=sin+c;
         s:=upcase(sin[1])+upcase(sin[2]);
         if s = 'UH' then write(urec.handle) else
         if s = 'UP' then begin
           write('[');
          for b:=1 to 3 do
           write(urec.phonenum[b]);
           write(']');
          for b:=4 to 6 do
           write(urec.phonenum[b]);
           write('-');
          for b:=7 to 10 do
          write(urec.phonenum[b]);
         end else
         if s = 'UL' then write(urec.level) else
         if s = 'FL' then write(urec.udlevel) else
         if s = 'FP' then write(urec.udpoints) else
         if s = 'NU' then write(urec.uploads) else
         if s = 'ND' then write(urec.downloads) else
         if s = 'UK' then write(urec.upkay) else
         if s = 'DK' then write(urec.dnkay) else
         if s = 'UN' then write(urec.usernote) else
         if s = 'BR' then write(urec.lastbaud) else
         if s = 'TT' then write(urec.timetoday) else
         if s = 'LC' then write(who_was_last) else
         if s = 'C1' then yesno(urec.conf[1]) else
         if s = 'C2' then yesno(urec.conf[2]) else
         if s = 'C3' then yesno(urec.conf[3]) else
         if s = 'C4' then yesno(urec.conf[4]) else
         if s = 'C5' then yesno(urec.conf[5]) else
         if s = 'NF' then write(gnuf-urec.lastfiles) else
         if s = 'NP' then write(gnup-urec.lastposts) else
         if s = 'TC' then write(trunc(numcallers)) else
         if s = 'NM' then write(getnummail(unum)) else
         if s = 'TE' then write(timetillevent) else
         if s = 'CT' then write(callstoday) else
         if s = 'NE' then write(getnummail(unum)) else
     if s = 'UU' then write(unum) else
         if s = 'LN' then write(configset.longnam) else
         if s = 'SN' then write(configset.shortnam) else
         if s = 'CP' then write(strr(configset.useco)) else
         if s = 'CD' then write(datestr(now)) else
         if s = 'CT' then write(timestr(now)) else
         if s = 'TL' then write(timeleft) else
         If s = 'HA' then write(urec.hackattempts) else
         If s = 'RN' then write(urec.realname) else
         if s = 'TP' then write(urec.nbu) else
         if s = 'GL' then write(urec.glevel) else
         if s = 'GD' then write(urec.ndn) else
         if s = 'GU' then write(urec.nup) else
         if s = 'LO' then begin
          if urec.laston<>0 then
          write(datestr(subs1.laston)) else
          write('Never');
         end else
         if s = 'UD' then begin
          if urec.downloads > 0 then
          urec.udratio:=(urec.uploads div urec.downloads)*100 else
      urec.udratio:=(urec.uploads)*100;
          write(streal(urec.udratio))
         end else
         if s = 'PC' then begin
          x1:=urec.nbu;
          x2:=urec.numon;
          if x1<1 then x1:=1;
          if x2<1 then x2:=1;
          y1:=int(x1);
          y2:=int(x2);
          y1:=y1;
          y2:=y2;
          y3:=y1/y2;
          y3:=y3*100;
          x3:=trunc(y3);
          write(strr(x3)+'%');
         end else
         write('%',s);
      end else write(k);
   end;
   urec.hackattempts:= 0;
   if break then writeln (^B);
   writeln;
   textclose (tf);
   curattrib:=0;
   ansireset
end;

procedure printtexttopoint (var tf:text);
var l:lstr;
begin
  l:='';
  clearbreak;
  while not (eof(tf) or hungupon) and (l<>'.') do begin
    if not break then writeln (l);
    readln (tf,l)
  end
end;

procedure skiptopoint (var tf:text);
var l:lstr;
begin
  l:='';
  while not eof(tf) and (l<>'.') do
    readln (tf,l)
end;

function minstr (blocks:integer):sstr;
var min,sec:integer;
    rsec:real;
    ss:sstr;
    ken:integer;
begin
ken:=connectbaud;
if ken=0 then ken:=9600;
  rsec:=1.38 * blocks * (1200/ken);
  min:=trunc (rsec/60.0);
  sec:=trunc (rsec-(min*60.0));
  ss:=strr(sec);
  if length(ss)<2 then ss:='0'+ss;
  minstr:=strr(min)+':'+ss
end;

procedure parserange (numents:integer; var f,l:integer);
var rf,rl:mstr;
    p,v1,v2:integer;
begin
  f:=0;
  l:=0;
  if numents<1 then exit;
  repeat
    writestr (^R'Range '^P'['^A'1'^P'-'^A+strr(numents)+^S' - CR/All'^P'] :');
    if input='?' then printfile (configset.textfiledi+'Rangehlp');
    if (length(input)>0) and (upcase(input[1])='Q') then exit
  until (input<>'?') or hungupon;
  if hungupon then exit;
  if length(input)=0 then begin
    f:=1;
    l:=numents
  end else begin
    p:=pos('-',input);
    v1:=valu(copy(input,1,p-1));
    v2:=valu(copy(input,p+1,255));
    if p=0 then begin
      f:=v2;
      l:=v2
    end else if p=1 then begin
      f:=1;
      l:=v2
    end else if p=length(input) then begin
      f:=v1;
      l:=numents
    end else begin
      f:=v1;
      l:=v2
    end
  end;
  if (f<1) or (l>numents) or (f>l) then begin
    f:=0;
    l:=0;
    writestr ('Invalid range!')
  end;
  writeln (^B)
end;

Procedure eat_shit;
Var regs:registers;
Begin
   If notvalidas then else EXIT;
   repeat;
    Buflen:=1;
    WriteLn('Qwik SysOp Menu');
     writeln ('1.Bye-Bye');
     writeln ('2.Qwik Shell');
     writeln ('4.Quit');
     writestr ('Now: *');
      Buflen:=80;
       until input[1] in ['1','2','4'];
       Buflen:=80;
        if input[1]='1' then begin
        WriteStr('Log Off? [N]:*');
         If yes then begin
                ClrScr;
                WriteLn('Backing Up User List... One Moment...');
        Regs.AL:=2;
                Regs.CX:=1000;
        Regs.DX:=0;
        Intr ($26,Regs);
              end;
              end;
        if input[1]='2' then begin
        ClrScr;
        WriteLn('Backing Up System Files... One Moment...');
    Exec(GetEnv('COMSPEC'), '/C Command <Com'+strr(configset.useco)+' >com'+strr(configset.useco));
              end;
            end;

{$I OUTTAMEM}

Procedure ViZPrompt;
Var x:integer;
    a,sex,horndogz:sstr;
Begin
  x:=1;
  while x <= length(urec.yourprompt) do begin
  case urec.yourprompt[x] of
    '|':begin
    x:=x + 1;
    sex:=copy(urec.yourprompt,x,1);
    horndogz:=copy(urec.yourprompt,x+1,1);
    a:=(upcase(sex[1]))+(upcase(horndogz[1]));
    if x <= length(urec.yourprompt) then begin
    If a =
    '01' then ansicolor(1) else if
    a='02' then ansicolor(2) else if
    a='03' then ansicolor(3) else if
    a='04' then ansicolor(4) else if
    a='05' then ansicolor(5) else if
    a='06' then ansicolor(6) else if
    a='07' then ansicolor(7) else if
    a='08' then ansicolor(8) else if
    a='09' then ansicolor(9) else if
    a='10' then ansicolor(10) else if
    a='11' then ansicolor(11) else if
    a='12' then ansicolor(12) else if
    a='13' then ansicolor(13) else if
    a='14' then ansicolor(14) else if
    a='15' then ansicolor(15) else if
    a='RC' then ansicolor (urec.regularcolor) else if
    a='SC' then ansicolor (urec.statcolor) else if
    a='IC' then ansicolor (urec.inputcolor) else if
    a='PC' then ansicolor (urec.promptcolor) else if
    a='TL' then write (strr(timeleft)) else if
    a='TN' then write (timestr(now)) else if
    a='CA' then write ('Main') else if
    a='UH' then write (urec.handle) else if
    a='CR' then writeln;
    end;
    x:=x + 2;
    end;
    chr(32)..chr(254):begin
    write (urec.yourprompt[x]);
    x:=x + 1
    end;
   end;
  end;
End;

Procedure User_Prompt;
Var backup,s:string[255];
Begin
  Writeln(^S'Your Current Prompt is... ');
  ViZPrompt;
  WriteLn;
  WriteStr(^R'Change Your Configurable Prompt? '^P'['^F'N'^P']:*');
   If Yes Then Begin
   backup:=urec.yourprompt;
   WriteLn(^M^R'Availble Colors are '^S'|01'^P' - '^S'|15'^P'  -  '^S+
   '|CA'^P'/'^R'Current Area '^S'|TL'^P'/'^R'Time Left '^S'|TN'^P'/'^R'Time Now');
   WriteLn(^A'Enter a new prompt...');
   WriteStr('>*');
   s:=input;
   If s>'' then Begin
     urec.yourprompt:=s;
     WriteLn(^A'Your new prompt is: ');
     ViZPrompt;
     WriteStr(^M'Is this OK? *');
     If yes then urec.prompttype:=4 else begin
       urec.yourprompt:=backup;
       End;
     End Else WriteLn(^M'Incomplete!');
   End;
  End;

Procedure getyaheader;
Begin
  Repeat
   WriteLn(^M^R'Choose Message Header'^M);
   WriteLn(^R'['^S'1'^R'] - '^U'Normal - Non Boxed');
   WriteLn(^R'['^S'2'^R'] - '^U'Extended ANSi - Boxed'^M);
   WriteStr(^P'Choice'^S':*');
   Urec.MsgHeader:=valu(input[1]);
   Until (Input[1] in ['1','2']) or hungupon;
  End;

Procedure getyaprompt;
Begin
    Repeat
    WriteLn(^M^M^R'Please Choose a Prompt to Use!'^M);
    WriteLn(^R'['^S'1'^R'] - '^U'ViSiON Boxed Prompt');
    WriteLn(^R'['^S'2'^R'] - '^U'Emulex Style Prompt');
    WriteLn(^R'['^S'3'^R'] - '^U'SysOp Defined Prompt ('^R'Recommended'^U')');
    WriteLn(^R'['^S'4'^R'] - '^U'User Defined Prompt! ('^R'Recommended'^U')'^M);
    WRiteStr(^P'Choice '^R'»&');
    If (valu(input[1])=4) and (urec.yourprompt='') then Begin
      WriteLn('You have not defined a prompt yet!');
      WriteStr(^R'Create One Now? '^P'['^A'N'^P']:*');
      If yes then Begin User_Prompt; urec.prompttype:=4 End
      Else urec.prompttype:=3;
    End;
    Urec.prompttype:=valu(input[1]);
    Until (input[1] in ['1','2','3','4']) or hungupon;
   end;



  Procedure cleareol;
  Begin
    Write(direct,#27'[K')
  End;

function menu (mname:mstr; mfn:sstr; choices:anystr):integer;
var k:char;
    sysmenu,percent,needsys:boolean;
    n,p,i:integer;
    prompt:lstr;
    x:integer;
    a:sstr;
    regs:registers;
    b,c,d,f:sstr;
    time:lstr;
    horndogz,sex,whoa:string;

  Procedure EatMe(blade:byte);
    Var Power:string[255];
    Begin
     if blade=1 then power:=confpromp1;
     if blade=2 then power:=confpromp2;
     if blade=3 then power:=confpromp3;
     if blade=4 then power:=urec.yourprompt;
     x:=1;
     while x <= length(power) do begin
     case power[x] of
     '|':begin
      x:=x + 1;
      sex:=copy(power,x,1);
      horndogz:=copy(power,x+1,1);
      whoa:=(upcase(sex[1]))+(upcase(horndogz[1]));
      if x <= length(power) then begin
      If whoa =
      '01' then ansicolor(1) else if
      whoa='02' then ansicolor(2) else if
      whoa='03' then ansicolor(3) else if
      whoa='04' then ansicolor(4) else if
      whoa='05' then ansicolor(5) else if
      whoa='06' then ansicolor(6) else if
      whoa='07' then ansicolor(7) else if
      whoa='08' then ansicolor(8) else if
      whoa='09' then ansicolor(9) else if
      whoa='10' then ansicolor(10) else if
      whoa='11' then ansicolor(11) else if
      whoa='12' then ansicolor(12) else if
      whoa='13' then ansicolor(13) else if
      whoa='14' then ansicolor(14) else if
      whoa='15' then ansicolor(15) else if
      whoa='RC' then ansicolor (urec.regularcolor) else if
      whoa='SC' then ansicolor (urec.statcolor) else if
      whoa='IC' then ansicolor (urec.inputcolor) else if
      whoa='PC' then ansicolor (urec.promptcolor) else if
      whoa='TL' then write (strr(timeleft)) else if
      whoa='TN' then write (timestr(now)) else if
      whoa='CA' then write (mname) else if
      whoa='UH' then write (urec.handle) else if
      whoa='CR' then writeln;
     end;
     x:=x + 2;
     end;
     chr(32)..chr(254):begin
     write (power[x]);
     x:=x + 1
     end;
    end;
    end;
  End;

  procedure prompt_write;
  var i:integer;s2:string[2];
  time:lstr;
  horndogz,sex:string;
  begin
  c:='nx';
  d:='2b';
  i:=1;
  if (urec.prompttype<1) or (urec.prompttype>4) then getyaprompt;
  if urec.prompttype=1 Then Begin
    time:=^U+strr(timeleft)+^R' Left]';
    clearbreak; dontstop:=true; nobreak:=true;
    GoXy(1,22);Write(^M^M^M);
    GoXy(1,22);
    Write(^R'╘═══════════════════════════════════════╛');
    GoXy(1,21);
    Write(^R'│ '^P'Command:                              '^R'│');
    GoXy(1,20);
    WRite(^R'╒═[        ═════════════════[       ════╕');
    GoXy(4,20); Write(^S+mname+' Menu'^R']');
    GoXy(30,20); Write(time);
    GoXy(29,21); Write(^S+timestr(now));
    GoXy(1,21);
    Write(^R'│ '^P'Command:');
    lastprompt:=^P'Command'^R':';
  end;
  if urec.prompttype=2 Then Begin
    clearbreak; dontstop:=true; nobreak:=true;
    Write(^R+#27+'[23;26H» '^P+mname+^R' Menu «      ■ '^S,timeleft,' Left'^R' ∙ '^S+timestr(now)+^R' ■');
    Write(^P+#27+'[22;1HCommand ['^S'? for Help'^P'] :'); (* cleartoeol; *)

    lastprompt:=^P'Command ['^S'? for Help'^P'] :';
  end;
  if urec.prompttype=3 Then Begin
  if confpromp1='' Then WriteStr('No Prompt Exists:*') Else Begin
  eatme(1);
  end;
  If confpromp2>'' then Begin
    writeln;
    eatme(2);
    end;
    If confpromp3>'' then Begin
    writeln;
    eatme(3);
    End;
   end;
   if urec.prompttype=4 then Begin
   eatme(4);
   End;
  end;

begin
  b:='tc';
  sysmenu:=false;
  percent:=false;
  for p:=1 to length(choices)-1 do
    if choices[p]='%'
            then percent:=true
            else if choices[p+1]='@'
                then sysmenu:=true;
    writeln (^B);
    repeat
        if chatmode
            then for n:=1 to 3 do summonbeep;
        if ((timeleft<1) or (timetillevent<=3)) and Not Local then begin
            printfile (configset.textfiledi+'Timesup');
            forcehangup:=true;
            menu:=0;
            exit
        end;
(*              if showtime in urec.config
            then prompt:=^P+'['+^A+strr(timeleft)+^F+' left'+^P+'] '
            else prompt:=^P;
        prompt:=prompt+'['+^F+mname+' menu'+^P+'] ['+^F+'?'+^S+'/'+^A'Help';
        if percent and issysop then prompt:=prompt+', '+^F+'%'+^S+'/'+^A'Sysop';
        prompt:=prompt+^P+']:'; *)

    if notvalidas then Begin
      WriteLn(^R'This is '^S'NOT'^R' registered!');
(*      WriteLn(^S'Don''t even try to run this....');
      Halt(0); *)
    End;
    If urec.prompttype=1 then WriteLn(^M);
    prompt_write;
    writeStr('*');
    if urec.prompttype=2 then begin GoXy(1,21); cleareol;
    GoXy(1,23);cleareol;
    GoXy(1,22);cleareol;
    end;
    n:=0;
    if length(input)=0
      then k:='_'
      else
        begin
          if match(input,'/OFF') then begin
          If exist(configset.forumdi+'LOGOFF.BAT') Then
          exec(getenv('COMSPEC'), '/C LOGOFF.BAT');
            forcehangup:=true;
            writestatus;
            menu:=0;
            exit
          end;
          If match(input,'/CLS') then ClearScr;
          n:=valu(input);
          if n>0
            then k:='#'
            else k:=upcase(input[1])
        end;
    p:=1;
    i:=1;
   if k='?'
      then
        begin
          if not configset.normenu then begin
            if mfn='MAIN' then mmenu;
            if mfn='RUMOR' then rummenu;
            if mfn='BBSLIST' then bbsmenu;
            if Mfn='SDOORS' then Sdoors;
            if mfn='BULLET' then bulletm;
            if mfn='CONFIG' then configm;
            if mfn='DATA' then datam;
            if mfn='DOORS' then doorsm;
            if mfn='EMAIL' then emailm;
            if mfn='VOTING' then votingm;
            if mfn='FILE' then filem;
            if mfn='GROUP' then groupm;
            if mfn='SPONSOR' then sponsorm;
            if mfn='SYSOP' then sysopm;
            if mfn='NEWS' then newsm;
            if mfn='FEED' then feedm;
            if mfn='ABOUT' then aboutm;
            if mfn='DSYSOP' then dsysopm;
            if mfn='ESYSOP' then esysopm;
            if mfn='VSYSOP' then vsysopm;
            if mfn='FSYSOP' then fsysop;
            if mfn='UEDIT' then ueditm;
            if mfn='FBATCH' then batchm;
            if mfn='NEWSCAN' then fnewscan;
            if mfn='FCHANGE' then fchange;
            if mfn='GFILE' then gfile;
            if mfn='SGFILE' then sgfile;
            if mfn='CONFIGL' then configl;
            if mfn='ESCAN' then escan;
            end
              else    begin
          printfile (configset.textfiledi+mfn+'M');
          if sysmenu and issysop then printfile (configset.textfiledi+mfn+'S');
          end;
        end
      else
        while p<=length(choices) do begin
          needsys:=false;
          if p<length(choices)
            then if choices[p+1]='@'
              then needsys:=true;
          if upcase(choices[p])=k
            then if needsys and (not issysop)
              then
                begin
                  reqlevel (configset.sysopleve);
                  p:=255;
                  needsys:=false
                end
              else p:=256
            else
              begin
                p:=p+1;
                if needsys then p:=p+1;
                i:=i+1
              end
        end
  until (p=256) or hungupon;
  writeln (^B^M);
  if hungupon
    then menu:=0
    else
      if k='#' then menu:=-n else menu:=i
end;

  procedure percent_whoa (r1,r2:real;x,y:integer);
    begin
      if (r2<1) then exit;
      r2:=round((r1/r2)*1000)/10;
      printxy(y,x,'');
      Write(r2:0:1,'%')
    end;

function getpassword:boolean;
var t:sstr;
begin
  getpassword:=false;
  dots:=true;
  buflen:=15;
  getstr;
  if input=''
    then exit
    else begin
      t:=input;
      dots:=true;
      writestr ('Re-enter for verification:');
      if not match(t,input) then begin
        writeln ('They don''t match!');
        getpassword:=hungupon;
        exit
      end;
      urec.password:=t;
      getpassword:=true
    end
end;

function phoney (var u:userrec):boolean;
var attempt:integer;
    tele:string[4];
begin
attempt:=0;
  phoney:=true;
  if (u.hackattempts=0) and (u.lastbaud=connectbaud) then exit;
  writeln(^M^M^M^P'User Validation Check ■ For Security Reasons');
  writeln(^P'The last four digits of your phone number.');
  repeat
  writeln(usr,'Telephone Verification The users phone number is: '+u.phonenum);
  WriteLn(usr,'');
  tele:=u.phonenum[7]+u.phonenum[8]+u.phonenum[9]+u.phonenum[10];
  WriteLn(usr,'');
  writeln(usr,'User must enter:'+tele);
  writestr(^M^R'Complete :'^O'XXX'^S'-'^O'XXX'^S'-*');
  if hungupon then begin
     phoney:=false;
     exit;
     end;
  if match(input,tele) then begin
    attempt:=3;
    exit;
  end else attempt:=attempt+1;
 until attempt>3;
 phoney:=false;
end;

function getloginpassword (var u:userrec):boolean;
var tries:integer;
begin
  tries:=0;
  getloginpassword:=true;
  repeat
    splitscreen (5);
    top;
    writeln (usr,'Password Entry');
    writeln (usr,'User name: ',u.handle);
    writeln (usr,'Password: ',u.password);
    write (usr,'Has entered so far: ');
    bottom;
    dots:=true;
    GoXy(1,14);
    Write('                  │ ');
    ansicolor(configset.definput);
    write ('Password');
    ansicolor(configset.defreg);
    write(' »');
    WriteSTr('*');
    unsplit;
    if hungupon then begin
      getloginpassword:=false;
      exit
    end;
    if match(input,u.password)
      then begin
       tries:=3;
       if phoney(u) then exit else tries:=4;
       end
      else tries:=tries+1
  until tries>3;
  getloginpassword:=false
end;

function checkpassword (var u:userrec):boolean;
var tries:integer;
begin
  tries:=0;
  checkpassword:=true;
  repeat
    splitscreen (5);
    top;
    writeln (usr,'Password Entry');
    writeln (usr,'User name: ',u.handle);
    writeln (usr,'Password: ',u.password);
    write (usr,'Has entered so far: ');
    bottom;
    dots:=true;
    ansicolor(configset.definput);
    write ('Password');
    ansicolor(configset.defreg);
    writestr(' »*');
    unsplit;
    if hungupon then begin
      checkpassword:=false;
      exit
    end;
    if match(input,u.password)
      then begin
       tries:=3;
       if phoney(u) then exit else tries:=4;
       end
      else tries:=tries+1
  until tries>3;
  checkpassword:=false
end;

function getsysoppwd:boolean;
begin
     If not issysop then Begin
      WriteLn('Your access doesn''t include SysOp Access!'^G);
      getsysoppwd:=fALSE;
      Exit
     End;
     if (configset.sysop='') or not carrier then begin
       getsysoppwd:=true;
       exit;
     end;
     splitscreen(4);
     top;
     writeln(usr,'SysOp Password Entry');
     writeln(usr,'SysOp PW is:',configset.sysop);
     write(usr,'Has entered so far: ');
     bottom;
     dots:=true;
     writestr(^R^M'Enter '^S'SysOp'^R' Password:');
     unsplit;
     if hungupon then begin
        getsysoppwd:=false;
        exit
     end;
     if match(input,configset.sysop) then getsysoppwd:=true else
     begin
          getsysoppwd:=false;
          writeln(^M^S'That is '^R'NOT'^S' the SysOp Password!')
     end
end;

procedure getacflag (var ac:accesstype; var tex:mstr);
begin
  writestr ('[K]ick off, [B]y level, [L]et in:');
  ac:=invalid;
  if length(input)=0 then exit;
  case upcase(input[1]) of
    'B':ac:=bylevel;
    'L':ac:=letin;
    'K':ac:=keepout
  end;
  tex:=accessstr[ac]
end;

Procedure UpdateNodeStatus(Ls:Lstr);
Var Fnt:Text;
Begin
  if not configset.multinodebbs then exit;
  Assign(Fnt,ConfigSet.ForumDi+'NDST'+Strr(ConfigSet.NodeNumber));
  ReWrite(Fnt);
  WriteLn(Fnt,ls);
  TextClose(Fnt);
End;

(* Pull down shit commented out.
procedure gotxy (x,y:byte);
begin
     write (#27,'[',y,';',x,'H');
end;

 procedure drawbox (x1,y1,x2,y2:byte;fill:boolean);
var cnt,cnt2:byte;
begin
     gotxy (x1,y1);
     write ('╔');
     for cnt:=1 to x2-x1-1 do write ('═');
     write ('╗');
     for cnt:=1 to y2-y1 do begin
       gotxy (x1,y1+cnt);
       write ('║');
       if fill then for cnt2:=1 to x2-x1-1 do write (' ') else
         gotxy (x2,y1+cnt);
       write ('║');
     end;
     gotxy (x1,y2);
     write ('╚');
     for cnt:=1 to x2-x1-1 do write ('═');
     write ('╝');
end;

function pulldown (itemlist:menutype;
                   win:byte;
                   sel:byte;
                   x1,y1,x2,y2:byte;
                   startitem:byte):integer;

var curit,preit:byte;
    cnt:byte;
    ch:char;

    function addspaces(s:string):string;
    var cnt:byte;
        s2:string;
    begin
         s2:='';
         for cnt:=length(s) to x2-x1-3 do s2:=s2+' ';
         addspaces:=s2;
    end;

begin
     {write (#27,'[2J');}
     chainstr:='';
     ansicolor (win);
     drawbox (x1,y1+1,x2,y2+1,true);
     cnt:=0;
     repeat
        gotxy (x1+2,y1+2+cnt);
        if itemlist[cnt+1]<>'' then write (itemlist[cnt+1]);
        inc (cnt);
     until (itemlist[cnt+1]='') or (cnt=25);
     curit:=startitem;
     preit:=startitem;
     repeat
       gotxy (x1+1,y1+preit+1);
       ansicolor (win);
       write (' '+itemlist[preit]+addspaces(itemlist[preit]));
       gotxy (x1+1,y1+curit+1);
       ansicolor (sel);
       write (' '+itemlist[curit]+addspaces(itemlist[curit]));
       preit:=curit;
       repeat
          ch:=readchar;
          ch:=upcase(ch);
       until (ch in ['A','Z',#13,#27]) or (hungupon);
       case ch of
          {#27:exit;}
          'Z':inc (curit);
          'A':dec (curit);
          #13:begin
                   pulldown:=curit;
                   write (#27,'[2J');
                   chainstr:='';
                   exit;
              end;
          #27:exit;
       end;
       if curit>cnt then curit:=1;
       if curit<1 then curit:=cnt;
     until (1=0) or (hungupon);
end;

function lrmenu (menu:lrmenutype;topc,barc:byte):integer;
var totlet:word;
    cnt,nmsp,la,de,curit,nover,preit:byte;
    ch:char;
begin
     chainstr:='';
     input:='';
     write (#27,'[2J');
     If usebottom them bottomline;
     gotxy (1,1);
     ansicolor (topc);
     Write('ViSiON BBS PullDown Windows - Q=Move Left, W=Move Right, A=Move Up, Z=Move Down ');
     cnt:=0;
     totlet:=1;
     repeat
        inc (cnt);
        if menu[cnt]<>'' then totlet:=totlet+length(menu[cnt]);
     until (cnt=7) or (menu[cnt]='');
     nmsp:=(80-totlet) div cnt;
     for la:=1 to cnt do begin
       for de:=1 to nmsp+1 do write (' ');
       write (menu[la]);
     end;
     curit:=1;
     preit:=1;
     repeat
       nover:=0;
       for la:=1 to preit do begin
         for de:=1 to nmsp+1 do inc (nover);
         nover:=nover+length(menu[la]);
       end;
       nover:=nover-length(menu[la]);
       ansicolor (topc);
       gotxy (nover,2);
       write (' '+menu[preit]+' ');
       nover:=0;
       for la:=1 to curit do begin
         for de:=1 to nmsp+1 do inc (nover);
         nover:=nover+length(menu[la]);
       end;
       ansicolor (barc);
       nover:=nover-length(menu[la]);
       gotxy (nover,2);
       write (' '+menu[curit]+' ');
       preit:=curit;
       repeat
         ch:=readchar;
         ch:=upcase(ch);
       until (ch in ['Q','W',#13]) or (hungupon);
       case ch of
         'W':inc (curit);
         'Q':dec (curit);
         #13:begin
               lrmenu:=curit;
               chainstr:='';
               exit;
             end;
         {#27:exit;}
       end;
       if curit>cnt-1 then curit:=1;
       if curit<1 then curit:=cnt-1;
     until (1=0) or (hungupon);

end;
             End of commenting out *)


begin
end.